home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 041-050 / amok48 / module / txt / newinout.mod < prev    next >
Text File  |  1993-11-04  |  21KB  |  681 lines

  1. (**********************************************************************
  2.  
  3. :Program.    NewInOut.mod
  4. :Contens.    Ein Bibliotheksmodul für gepufferte Ein- und Ausgabe.
  5. :Contens.    Kompatibel zu InOut.
  6. :Author.     Bernd Braun
  7. :Address.    Lippestr. 11, D-3300 Braunschweig
  8. :Phone.      0531/845498
  9. :Copyright.  Public Domain
  10. :Language.   Modula-2
  11. :Translator. M2Amiga A+L V3.32d
  12. :Support.    Tooltype-Übergabe nach Amiga 12/89 S.86f. Andreas Görtler.
  13. :History.    V1.0 25.Sep.1989 Erste lauffähige Version
  14. :History.    V1.1 26.Apr.1990 Kosmetische Verbesserungen
  15. :History.    V1.2 26.Sep.1990 Tooltypeübergabe implementiert
  16. :History.    V1.3 22.Dez.1990 Jeweils bei Read-String, -Int, -LongInt, 
  17. :History.                     -Card und -LongCard FlushOutput eingefügt.
  18.  
  19. ***********************************************************************)
  20.  
  21. (* $R- $V- $S- $F- *) (* Programm läuft bisher ohne Fehler. *)
  22.  
  23. IMPLEMENTATION MODULE NewInOut;
  24.  
  25.    FROM Arts IMPORT
  26.       startupMsg, TermProcedure, Assert, wbStarted;
  27.    FROM ASCII IMPORT
  28.       eof, nul, cr, bs, sp, csi;
  29.    FROM Conversions IMPORT
  30.       StrToVal, ValToStr;
  31.    FROM Dos IMPORT
  32.       Input, Output, FileHandlePtr, WaitForChar, oldFile, newFile;
  33.    IMPORT Dos;
  34.    FROM Icon IMPORT
  35.       GetDiskObject, FreeDiskObject, FindToolType;
  36.    FROM Storage IMPORT
  37.       ALLOCATE, DEALLOCATE;
  38.    FROM SYSTEM IMPORT
  39.       ADR, TSIZE, CAST;
  40.    FROM Workbench IMPORT
  41.       WBStartupPtr, DiskObjectPtr;
  42.  
  43.    CONST
  44.       buflen   = 1024;
  45.       (* Länge der Ein- und Ausgabe-Puffer. *)
  46.       filemsg  = 'File ist nicht geöffnet!';
  47.       winerror = 'Fehler bein Öffnen des Windows!';
  48.       defwin   = 'con:0/50/640/150/NewInOut';
  49.       memerror = 'Kein Speicher mehr frei!';
  50.       Tooltype = 'WINDOW';
  51.  
  52.    TYPE
  53.       buffer   = ARRAY [ 0 .. buflen - 1] OF CHAR;
  54.       (* Typ der Ein- und Ausgabe-Puffer. *)
  55.       FILE     = POINTER TO FILEREC;
  56.       FILEREC  = RECORD
  57.                     inbuffer, outbuffer  : buffer;
  58.                     inbufptr,
  59.                     outbufptr, inbufmax  : INTEGER;
  60.                     handle               : FileHandlePtr;
  61.                  END;
  62.       (* Ein File besteht aus einem Ein- und einem Ausgabepuffer, zwei
  63.          Zeiger auf das aktuelle Zeichen im Ein- und Ausgabepuffer, einem
  64.          Zeiger auf die Maximale Anzahl Zeichen im Eingabe-Puffer und
  65.          einem Pointer auf den DOSFileHandlePointer. *)
  66.       FileListPtr = POINTER TO FileList;
  67.       FileList    = RECORD
  68.                        file : FILE;
  69.                        next : FileListPtr;
  70.                     END;
  71.       (* In der FileListe werden alle geöffneten Files in einer einfachen
  72.          linearen Liste gespeichert. *)
  73.  
  74.       StringPtr   = POINTER TO String;
  75.       String      = ARRAY [ 0 .. 107 ] OF CHAR;
  76.  
  77.    VAR
  78.       ownwindow      : BOOLEAN;
  79.       out            : FILE;
  80.       FileListe      : FileListPtr;
  81.       oldout, oldin  : FILE;
  82.       (* Speicherung der alten stdin und stdout für OpenInput,
  83.          OpenOutput. *)
  84.  
  85.       wbstartupptr   : WBStartupPtr;
  86.       stringptr      : StringPtr;
  87.       diskobjectptr  : DiskObjectPtr;
  88.       toolarrayptr   : POINTER TO StringPtr;
  89.  
  90.    (* Berechnung der Lände eines Strings. *)
  91.    PROCEDURE Length ( Str : ARRAY OF CHAR ) : INTEGER;
  92.       VAR
  93.          len : INTEGER;
  94.    BEGIN
  95.       len := 0;
  96.       WHILE ( len <= HIGH ( Str ) ) AND ( Str [ len ] # nul ) DO
  97.          INC ( len );
  98.       END;
  99.       RETURN len;
  100.    END Length;
  101.  
  102.    (* Initialieren eines Files. *)
  103.    PROCEDURE InitFile ( Handle : FileHandlePtr ) : FILE;
  104.       VAR
  105.          file : FILE;
  106.    BEGIN
  107.       ALLOCATE ( file, TSIZE ( FILEREC ) );
  108.       Assert   ( file # NIL, ADR ( memerror ) );
  109.       WITH file ^ DO
  110.          outbufptr := 0;
  111.          inbufmax  := 0;
  112.          inbufptr  := 0;
  113.          handle    := Handle;
  114.       END;
  115.       RETURN file;
  116.    END InitFile;
  117.  
  118.    (* Schreiben aller Zeichen im Output-Puffer in file. *)
  119.    PROCEDURE FlushOutput ( file : FILE );
  120.       VAR
  121.          len : LONGINT;
  122.    BEGIN
  123.       Assert ( file # NIL, ADR ( filemsg ) );
  124.       done := TRUE;
  125.       WITH file ^ DO
  126.          IF outbufptr > 0 THEN
  127.             len := Dos.Write ( handle, ADR ( outbuffer ), outbufptr );
  128.             done := len = outbufptr;
  129.             outbufptr := 0;
  130.          END;
  131.       END;
  132.    END FlushOutput;
  133.  
  134.    (* Öffnen eines beliebigen Amiga-DOS Files. *)
  135.    PROCEDURE Open ( Datei : ARRAY OF CHAR; modus : Modus ) : FILE;
  136.       VAR
  137.          handle   : FileHandlePtr;
  138.          newfile  : FILE;
  139.          p, q     : FileListPtr;
  140.          DOSModus : CARDINAL;
  141.          len, n   : INTEGER;
  142.          Str      : String;
  143.    BEGIN
  144.       done := TRUE;
  145.       len  := Length ( Datei );
  146.       IF len = 0 THEN
  147.          (* Standart Ein- und Ausgabe. *)
  148.          IF modus = ModeOld THEN
  149.             newfile := stdin;
  150.          ELSE
  151.             newfile := stdout;
  152.          END;
  153.       ELSE
  154.          (* Konstante Strings haben kein nul-Zeichen am Ende.
  155.             AmigaDOS-Open erwartet aber ein nul-Zeichen am Ende des
  156.             Dateinamens. Deshalb diese umkopiererei. *)
  157.          FOR n := 0 TO len - 1 DO
  158.             Str [ n ] := Datei [ n ];
  159.          END;
  160.          Str [ len ] := nul;
  161.          IF modus = ModeOld THEN
  162.             DOSModus := oldFile;
  163.          ELSE
  164.             DOSModus := newFile;
  165.          END;
  166.          handle := Dos.Open ( ADR ( Str ), DOSModus );
  167.          IF handle = NIL THEN
  168.             (* File existiert nicht. *)
  169.             done := FALSE;
  170.             newfile := NIL;
  171.          ELSE
  172.             newfile := InitFile ( handle );
  173.             (* Anhängen des Files in die FileListe. *)
  174.             p := FileListe;
  175.             q := p;
  176.             WHILE p # NIL DO
  177.                q := p;
  178.                p := p ^. next;
  179.             END;
  180.             ALLOCATE ( p, TSIZE ( FileList ) );
  181.             Assert   ( p # NIL, ADR ( memerror ) );
  182.             IF q # NIL THEN
  183.                q ^. next := p;
  184.             ELSE
  185.                FileListe := p;
  186.             END;
  187.             WITH p ^ DO
  188.                file := newfile;
  189.                next := NIL;
  190.             END;
  191.          END;
  192.       END;
  193.       RETURN newfile;
  194.    END Open;
  195.  
  196.    (* Öffnen eines neuen Ausgabefiles anstelle stdin. In Datei steht das
  197.       zu öffnende Amiga-DOS File. Ist Datei leer wird ein Filename per
  198.       Tastatur angefragt.
  199.       Änderung gegenüber InOut:
  200.          - In Datei darf keine Extention wie '.mod' stehen sondern der
  201.            Dateiname oder ein Leerstring.
  202.          - Der Dateiname kann vorher ggf. mit ReadString eingegeben
  203.            werden. *)
  204.    PROCEDURE OpenInput ( Datei : ARRAY OF CHAR );
  205.       VAR
  206.          Str : ARRAY [ 0 .. 79 ] OF CHAR;
  207.    BEGIN
  208.       (* done wird von Open gesetzt. *)
  209.       IF Length ( Datei ) # 0 THEN
  210.          (* Angegebens File öffnen. *)
  211.          stdin := Open ( Datei, ModeOld );
  212.          IF stdin = NIL THEN
  213.             stdin := oldin;
  214.          END;
  215.       ELSE
  216.          (* Filename anfragen. *)
  217.          WriteStringFile ( oldout, 'newin>' );
  218.          FlushOutput     ( oldout );
  219.          ReadStringFile  ( oldin, Str );
  220.          IF Str [ 0 ] # '*' THEN
  221.             stdin := Open ( Str, ModeOld );
  222.             IF stdin = NIL THEN
  223.                stdin := oldin;
  224.             END;
  225.          END;
  226.       END;
  227.    END OpenInput;
  228.  
  229.    (* Öffnen eines neuen Ausgabefiles anstelle stdout. In Datei steht das
  230.       zu öffnende Amiga-DOS File. Ist Datei leer wird ein Filename per
  231.       Tastatur angefragt.
  232.       Änderung gegenüber InOut:
  233.          - In Datei darf keine Extention wie '.mod' stehen sondern der
  234.            Dateiname oder ein Leerstring.
  235.          - Der Dateiname kann vorher ggf. mit ReadString eingegeben
  236.            werden. *)
  237.    PROCEDURE OpenOutput ( Datei : ARRAY OF CHAR );
  238.       VAR
  239.          Str : ARRAY [ 0 .. 79 ] OF CHAR;
  240.    BEGIN
  241.       (* done wird von Open gesetzt. *)
  242.       IF Length ( Datei ) # 0 THEN
  243.          stdout := Open ( Datei, ModeNew );
  244.          IF stdout = NIL THEN
  245.             stdout := oldout;
  246.          END;
  247.       ELSE
  248.          WriteStringFile ( oldout, 'newout>' );
  249.          FlushOutput     ( oldout );
  250.          ReadStringFile  ( oldin, Str );
  251.          IF Str [ 0 ] # '*' THEN
  252.             stdout := Open ( Str, ModeNew );
  253.             IF stdout = NIL THEN
  254.                stdout := oldout;
  255.             END;
  256.          END;
  257.       END;
  258.    END OpenOutput;
  259.  
  260.    (* Schließen eines geöffneten Files. *)
  261.    PROCEDURE Close ( file : FILE );
  262.    BEGIN
  263.       (* Restliche Zeichen im Puffer ins File schreiben. *)
  264.       FlushOutput ( file );
  265.       IF file # NIL THEN
  266.          WITH file ^ DO
  267.             IF handle # NIL THEN
  268.                Dos.Close ( handle );
  269.                handle := NIL;
  270.             END;
  271.          END;
  272.          file := NIL;
  273.       END;
  274.    END Close;
  275.  
  276.    (* Schließen eines geöffneten Eingabefiles und Wiedereinsetzen von
  277.       stdin. *)
  278.    PROCEDURE CloseInput;
  279.    BEGIN
  280.       IF oldin # stdin THEN
  281.          Close ( stdin );
  282.          stdin := oldin;
  283.       END;
  284.    END CloseInput;
  285.  
  286.    (* Schließen eines geöffneten Ausgabefiles und Wiedereinsetzen von
  287.       stdout. *)
  288.    PROCEDURE CloseOutput;
  289.    BEGIN
  290.       IF oldout # stdout THEN
  291.          Close ( stdout );
  292.          stdout := oldout;
  293.       END;
  294.    END CloseOutput;
  295.  
  296.    (* Rückgabe des ersten Zeichens im Eingabepuffer von file. Ist er leer
  297.       werden neue Zeichen aus file gelesen und im Eingabepuffer
  298.       gespeichert. *)
  299.    PROCEDURE ReadFile ( file : FILE; VAR c : CHAR );
  300.       VAR
  301.          len : LONGINT;
  302.    BEGIN
  303.       Assert ( file # NIL, ADR ( filemsg ) );
  304.       FlushOutput ( file );
  305.       done := TRUE;
  306.       WITH file ^ DO
  307.          IF inbufptr = inbufmax THEN
  308.             (* Eingabepuffer ist leer. *)
  309.             len := Dos.Read ( handle, ADR ( inbuffer ), buflen );
  310.             IF len <= 0 THEN
  311.                (* Ende des Files. *)
  312.                done := FALSE;
  313.                c := eof;
  314.                RETURN;
  315.             ELSE;
  316.                inbufptr := 0;
  317.                inbufmax := len - 1;
  318.             END;
  319.          ELSE
  320.             INC ( inbufptr );
  321.          END;
  322.          c := inbuffer [ inbufptr ];
  323.       END;
  324.    END ReadFile;
  325.  
  326.    (* Rückgabe eines Zeichens aus stdin mit Hilfe von ReadFile. *)
  327.    PROCEDURE Read ( VAR c : CHAR );
  328.    BEGIN
  329.       ReadFile ( stdin, c );
  330.    END Read;
  331.  
  332.    (* Speichern eines Zeichens im Ausgabepuffer von file. Ist er voll
  333.       werden alle Zeichen im Ausgabepuffer in file geschrieben. *)
  334.    PROCEDURE WriteFile ( file : FILE; c : CHAR );
  335.    BEGIN
  336.       Assert ( file # NIL, ADR ( filemsg ) );
  337.       WITH file ^ DO
  338.          IF outbufptr >= buflen THEN
  339.             FlushOutput ( file );
  340.          END;
  341.          outbuffer [ outbufptr ] := c;
  342.          INC ( outbufptr );
  343.       END;
  344.    END WriteFile;
  345.  
  346.    (* Schreiben eines Zeichens in stdout mit Hilfe von WriteFile. *)
  347.    PROCEDURE Write ( c : CHAR );
  348.    BEGIN
  349.       WriteFile ( stdout, c );
  350.    END Write;
  351.  
  352.    (* Schreiben eines Strings in file. *)
  353.    PROCEDURE WriteStringFile ( file : FILE; Text : ARRAY OF CHAR );
  354.       VAR
  355.          len, n : INTEGER;
  356.    BEGIN
  357.       Assert ( file # NIL, ADR ( filemsg ) );
  358.       len := Length ( Text ) - 1;
  359.       FOR n := 0 TO len DO
  360.          WriteFile ( file, Text [ n ] );
  361.       END;
  362.    END WriteStringFile;
  363.  
  364.    (* Schreiben eines String in stdout mit Hilfe von WriteStringFile. *)
  365.    PROCEDURE WriteString ( Text : ARRAY OF CHAR );
  366.    BEGIN
  367.       WriteStringFile ( stdout, Text );
  368.    END WriteString;
  369.  
  370.    (* Schreiben einer neuen Zeile in File mit Hilfe von WriteFile. *)
  371.    PROCEDURE WriteLnFile ( file : FILE );
  372.    BEGIN
  373.       WriteFile   ( file, eol );
  374.       FlushOutput ( file );
  375.    END WriteLnFile;
  376.  
  377.    (* Schreiben einer neuen Zeile in stdout mit Hilfe von WriteLnFile. *)
  378.    PROCEDURE WriteLn;
  379.    BEGIN
  380.       WriteLnFile ( stdout );
  381.    END WriteLn;
  382.  
  383.    (* Eingabe eines Strings aus file.
  384.       Procedure ist für con-Windows und bel. Files geschrieben.
  385.       Kann gegen Procedur für raw-Windows ausgetauscht werden. *)
  386.    PROCEDURE ReadStringFile ( file : FILE; VAR Text : ARRAY OF CHAR );
  387.       VAR
  388.          len : INTEGER;
  389.          c   : CHAR;
  390.    BEGIN
  391.       Assert ( file # NIL, ADR ( filemsg ) );
  392.       len := 0;
  393.       (* Führende Leerzeichen überlesen. *)
  394.       REPEAT
  395.          ReadFile ( file, c );
  396.       UNTIL ( c = eof ) OR ( c # ' ');
  397.       WHILE ( c # eof ) AND ( c # eol ) AND ( len <= HIGH ( Text ) ) DO
  398.          Text [ len ] := c;
  399.          INC ( len );
  400.          ReadFile ( file, c );
  401.       END;
  402.       IF len <= HIGH ( Text ) THEN
  403.          Text [ len ] := nul;
  404.       END;
  405.       done := ( len # 0 ) AND ( c # eof );
  406.    END ReadStringFile;
  407.  
  408.    (* Eingabe eines Strings aus stdin mit Hilfe von ReadStringFile. *)
  409.    PROCEDURE ReadString ( VAR Text : ARRAY OF CHAR );
  410.    BEGIN
  411.       FlushOutput    ( stdout );       (* Bei Cli Ausgabe flushen. *)
  412.       ReadStringFile ( stdin, Text );
  413.    END ReadString;
  414.  
  415.    (* Eingabe eines Cardinal aus file. *)
  416.    PROCEDURE ReadCardFile ( file : FILE; VAR Card : CARDINAL );
  417.       VAR
  418.          Str      : ARRAY [ 0 .. 79 ] OF CHAR;
  419.          val      : LONGINT;
  420.          sig, err : BOOLEAN;
  421.    BEGIN
  422.       Card := 0;
  423.       ReadStringFile ( file, Str );
  424.       IF done THEN
  425.          sig := FALSE;
  426.          StrToVal ( Str, val, sig, 10, err );
  427.          IF NOT err AND ( val >= 0 ) AND ( val <= 65535 ) THEN
  428.             Card := CARDINAL ( val );
  429.          ELSE
  430.             done := FALSE;
  431.          END;
  432.       END;
  433.    END ReadCardFile;
  434.  
  435.    (* Eingabe eines Cardinal aus stdin mit Hilfe von ReadCardFile. *)
  436.    PROCEDURE ReadCard ( VAR Card : CARDINAL );
  437.    BEGIN
  438.       FlushOutput  ( stdout );       (* Bei Cli Ausgabe flushen. *)
  439.       ReadCardFile ( stdin, Card );
  440.    END ReadCard;
  441.  
  442.    (* Eingabe eines LongCardinal aus file. *)
  443.    PROCEDURE ReadLongCardFile ( file : FILE; VAR Card : LONGCARD );
  444.       VAR
  445.          Str      : ARRAY [ 0 .. 79 ] OF CHAR;
  446.          val      : LONGINT;
  447.          sig, err : BOOLEAN;
  448.    BEGIN
  449.       Card := 0;
  450.       ReadStringFile ( file, Str );
  451.       IF done THEN
  452.          sig := FALSE;
  453.          StrToVal ( Str, val, sig, 10, err );
  454.          IF NOT err AND ( val >= 0 ) THEN
  455.             Card := LONGCARD ( val );
  456.          ELSIF ( val < 0 ) AND NOT sig THEN
  457.             Card := CAST ( LONGCARD,  val );
  458.          ELSE
  459.             done := FALSE;
  460.          END;
  461.       END;
  462.    END ReadLongCardFile;
  463.  
  464.    (* Eingabe eines LongCardinal aus stdin mit Hilfe von ReadCardFile. *)
  465.    PROCEDURE ReadLongCard ( VAR Card : LONGCARD );
  466.    BEGIN
  467.       FlushOutput      ( stdout );       (* Bei Cli Ausgabe flushen. *)
  468.       ReadLongCardFile ( stdin, Card );
  469.    END ReadLongCard;
  470.  
  471.    (* Eingabe eines Integer aus file. *)
  472.    PROCEDURE ReadIntFile ( file : FILE; VAR Int : INTEGER );
  473.       VAR
  474.          Str      : ARRAY [ 0 .. 79 ] OF CHAR;
  475.          val      : LONGINT;
  476.          sig, err : BOOLEAN;
  477.    BEGIN
  478.       Int := 0;
  479.       ReadStringFile ( file, Str );
  480.       IF done THEN
  481.          sig := TRUE;
  482.          StrToVal ( Str, val, sig, 10, err );
  483.          IF NOT err AND ( val >= -32768 )
  484.                     AND ( val <= 32767 ) THEN
  485.             Int := INTEGER ( val );
  486.          ELSE
  487.             done := FALSE;
  488.          END;
  489.       END;
  490.    END ReadIntFile;
  491.  
  492.    (* Eingabe eines Integer aus stdin mit Hilfe von ReadCardFile. *)
  493.    PROCEDURE ReadInt ( VAR Int : INTEGER );
  494.    BEGIN
  495.       FlushOutput ( stdout );       (* Bei Cli Ausgabe flushen. *)
  496.       ReadIntFile ( stdin, Int );
  497.    END ReadInt;
  498.  
  499.    (* Eingabe eines LongInteger aus file. *)
  500.    PROCEDURE ReadLongIntFile ( file : FILE; VAR Int : LONGINT );
  501.       VAR
  502.          Str      : ARRAY [ 0 .. 79 ] OF CHAR;
  503.          sig, err : BOOLEAN;
  504.    BEGIN
  505.       Int := 0;
  506.       ReadStringFile ( file, Str );
  507.       IF done THEN
  508.          sig := TRUE;
  509.          StrToVal ( Str, Int, sig, 10, err );
  510.          IF err OR NOT sig AND ( Int < 0 ) THEN
  511.             Int := 0;
  512.             done := FALSE;
  513.          END;
  514.       END;
  515.    END ReadLongIntFile;
  516.  
  517.    (* Eingabe eines LongInteger aus stdin mit Hilfe von ReadCardFile. *)
  518.    PROCEDURE ReadLongInt ( VAR Int : LONGINT );
  519.    BEGIN
  520.       FlushOutput     ( stdout );       (* Bei Cli Ausgabe flushen. *)
  521.       ReadLongIntFile ( stdin, Int );
  522.    END ReadLongInt;
  523.  
  524.    (* Schreiben eines Cardinal oder LongCardinal in file mit der
  525.       Feldbreite Feld.
  526.       Ist Feld positiv rechtsbündig, bei negativ linksbündig.*)
  527.    PROCEDURE WriteCardFile ( file : FILE;
  528.                              Card : LONGCARD;
  529.                              Feld : INTEGER );
  530.       VAR
  531.          Str : ARRAY [ 0 .. 80 ] OF CHAR;
  532.          err : BOOLEAN;
  533.    BEGIN
  534.       ValToStr ( CAST ( LONGINT, Card ), FALSE, Str, 10, Feld, ' ',
  535.                  err );
  536.       WriteStringFile ( file, Str );
  537.    END WriteCardFile;
  538.  
  539.    (* Schreiben eines Cardinal oder LongCardinal in stdout mit der
  540.       Feldbreite Feld mit Hilfe von WriteCardFile.
  541.       Ist Feld positiv rechtsbündig, bei negativ linksbündig.*)
  542.    PROCEDURE WriteCard ( Card : LONGCARD; Feld : INTEGER );
  543.    BEGIN
  544.       WriteCardFile ( stdout, Card, Feld );
  545.    END WriteCard;
  546.  
  547.    (* Schreiben eines Integer oder LongInteger in file mit der
  548.       Feldbreite Feld.
  549.       Ist Feld positiv rechtsbündig, bei negativ linksbündig.*)
  550.    PROCEDURE WriteIntFile ( file : FILE;
  551.                             Int  : LONGINT;
  552.                             Feld : INTEGER );
  553.       VAR
  554.          Str : ARRAY [ 0 .. 80 ] OF CHAR;
  555.          err : BOOLEAN;
  556.    BEGIN
  557.       ValToStr ( Int, TRUE, Str, 10, Feld, ' ', err );
  558.       WriteStringFile ( file, Str );
  559.    END WriteIntFile;
  560.  
  561.    (* Schreiben eines Integer oder LongInteger in stdout mit der
  562.       Feldbreite Feld mit Hilfe von WriteCardFile.
  563.       Ist Feld positiv rechtsbündig, bei negativ linksbündig.*)
  564.    PROCEDURE WriteInt ( Int : LONGINT; Feld : INTEGER );
  565.    BEGIN
  566.       WriteIntFile ( stdout, Int, Feld );
  567.    END WriteInt;
  568.  
  569.    (* Schreiben eines Cardinal oder LongCardinal als HexZahl in file mit
  570.       der Feldbreite Feld.
  571.       Ist Feld positiv rechtsbündig, bei negativ linksbündig.*)
  572.    PROCEDURE WriteHexFile ( file : FILE;
  573.                             Hex  : LONGCARD;
  574.                             Feld : INTEGER );
  575.       VAR
  576.          Str : ARRAY [ 0 .. 80 ] OF CHAR;
  577.          err : BOOLEAN;
  578.          c   : CHAR;
  579.    BEGIN
  580.       IF Feld >= 0 THEN
  581.          c := '0';
  582.          (* Als führende Zeichen ein '0'. *)
  583.       ELSE
  584.          c := ' ';
  585.          (* Als nachfolgende Zeichen ein ' '. *)
  586.       END;
  587.       ValToStr ( Hex, TRUE, Str, 16, Feld, c, err );
  588.       WriteStringFile ( file, Str );
  589.    END WriteHexFile;
  590.  
  591.    (* Schreiben eines Cardinal oder LongCardinal als HexZahl in stdout
  592.       mit der Feldbreite Feld mit Hilfe von WriteHexFile.
  593.       Ist Feld positiv rechtsbündig, bei negativ linksbündig.*)
  594.    PROCEDURE WriteHex ( Hex : LONGCARD; Feld : INTEGER );
  595.    BEGIN
  596.       WriteHexFile ( stdout, Hex, Feld );
  597.    END WriteHex;
  598.  
  599.    (* Abschlußprocedur, die alle geöffneten Files wieder schließt. *)
  600.    PROCEDURE TermNewInOut;
  601.       VAR
  602.          p, q : FileListPtr;
  603.    BEGIN
  604.       IF ( out # NIL ) AND waitCloseGadget THEN
  605.          WriteLn;
  606.          WriteString ( '<ENTER>' );
  607.          FlushOutput ( out );
  608.          REPEAT
  609.          UNTIL WaitForChar ( out ^. handle, 600 );
  610.       END;
  611.       IF NOT wbStarted THEN
  612.          (* Standarteingabe flushen. *)
  613.          FlushOutput ( stdout );
  614.       END;
  615.       (* Schließen aller Files in der FileListe. *)
  616.       q := FileListe;
  617.       WHILE q # NIL DO
  618.          p := q ^. next;
  619.          FlushOutput ( q ^. file );
  620.          Close ( q ^. file );
  621.          DEALLOCATE ( q ^. file, TSIZE ( FILEREC ) );
  622.          DEALLOCATE ( q, TSIZE ( FileList ) );
  623.          q := p;
  624.       END;
  625.       IF diskobjectptr # NIL THEN
  626.          FreeDiskObject ( diskobjectptr );
  627.       END;
  628.    END TermNewInOut;
  629.  
  630. BEGIN
  631.    TermProcedure ( TermNewInOut );
  632.    (* Nach Programmschluß ( auch bei Absturz ) wird TermNewInOut
  633.       aufgerufen. *)
  634.    (* Beim Benutzen eines raw: Windows muß ein neues Window geöffnet
  635.       werden auch wenn das Programm vom CLI aus aufgerufen wird.
  636.       Die Abfrage auf wbStarted ist für con: Windows gedacht, denn bei
  637.       CLI-Start wird kein neues Window gebraucht. *)
  638.    ownwindow       := TRUE;
  639.    waitCloseGadget := TRUE;
  640.    FileListe       := NIL;
  641.    out             := NIL;
  642.    diskobjectptr   := NIL;
  643.    stdin           := NIL;
  644.    stdout          := NIL;
  645.    IF wbStarted THEN
  646.       (* Tooltype holen, falls vorhanden. *)
  647.       wbstartupptr := startupMsg;
  648.       diskobjectptr := GetDiskObject
  649.                        ( wbstartupptr ^. argList ^ [ 0 ] . name );
  650.       (* diskobjectptr = NIL kann vorkommen wenn mit dem Debugger
  651.          gearbeitet wird. Deshalb hier kein Assert verwenden. *)
  652.       IF diskobjectptr # NIL THEN
  653.          toolarrayptr := diskobjectptr ^. toolTypes;
  654.          stringptr := toolarrayptr ^;
  655.       END;
  656.       IF stringptr # NIL THEN
  657.          (* WINDOW-Eintrag suchen. *)
  658.          stringptr := FindToolType
  659.                       ( diskobjectptr ^. toolTypes, ADR ( Tooltype ) );
  660.          IF stringptr # NIL THEN
  661.             out    := Open ( stringptr ^, ModeNew );
  662.             Assert ( out # NIL, ADR ( winerror ) );
  663.             ownwindow := FALSE;
  664.          END;
  665.       END;
  666.       IF ownwindow THEN
  667.          (* Window-Voreinstellung. *)
  668.          out    := Open ( defwin, ModeNew );
  669.          Assert ( out # NIL, ADR ( winerror ) );
  670.       END;
  671.       stdout := out;
  672.       stdin  := stdout;
  673.    ELSE
  674.       stdout  := InitFile ( Output () );
  675.       stdin   := InitFile ( Input () );
  676.       (* Ein- und Ausgabeumlenkung aus dem CLI wird übernommen. *)
  677.    END;
  678.    oldin  := stdin;
  679.    oldout := stdout;
  680. END NewInOut.
  681.